perm filename CONV.F4[MSS,LCS] blob
sn#097576 filedate 1974-04-12 generic text, type T, neo UTF8
00100 COMMON/LL/L
00200 DIMENSION MM(2000),IB(200),ITOP(10)
00300 DO 100 K=1,10
00400 100 ITOP(K)=0
00500 TYPE 1
00600 KJ=1
00700 KN=1
00800 ITOP(1)=1
00900 1 FORMAT(' TYPE FILE NAME -- '$)
01000 3 FORMAT(3I)
01100 2 FORMAT(A5)
01200 ACCEPT 2,NM
01300 CALL IFILE(1,NM)
01400 14 CALL DPYSET(1,IB,200)
01440 KM=KJ
01500 5 READ(1,3)J,K,L
01600 IF(L.EQ.0)GO TO 7
01700 C L=0=END OF ITEM
01800 IF(L.NE.3)GO TO 4
01900 CALL AIVECT(J,K)
02000 L=100000000
02100 GO TO 6
02200 4 CALL AVECT(J,K)
02300
02400
02500 6 KJ=KJ+1
02600 CALL REPACK(KJ,J/9,K/9,MM)
02650 C /9 BECAUSE DRAWING PROG. MULTS BY 9
02700 GO TO 5
02800
02900 7 FORMAT(' KEEP IT? '$)
03000 CALL DPYOUT(1)
03100 TYPE 7
03200 ACCEPT 2,IA
03300 IF(IA.EQ.'N')GO TO 9
03400 IF(IA.EQ.'X')GO TO 8
03455 KJ=KJ+1
03480 MM(KM)=KJ-KM
03500 KN=KN+1
03600 ITOP(KN)=KJ
03700 GO TO 14
03800 9 KJ=ITOP(KN)-1
03900 GO TO 14
04000 8 TYPE 1
04100 ACCEPT 2,NM
04200 CALL OFILE(1,NM)
04300 WRITE(1,10),ITOP
04400 10 FORMAT(' 9999 ',10I5)
04500 M=1
04600 11 M=M+1
04700 J=ITOP(M-1)
04800 K=ITOP(M)-1
04900 IF(K)GO TO 12
05000 C 0=END
05100 N=1
05200 DO 13 JJ=J,K
05300 N=N+1
05400 13 IB(N)=MM(JJ)
05500 IB(1)=N
05600 CALL SAVE(IB)
05700 GO TO 11
05750 END FILE 1
05800 12 END
05900
06000 SUBROUTINE SAVE(M)
06100 DIMENSION M(1)
06200 J=7
06300 L=8
06400 DO 12 K=1,M(1),8
06500 IF(K+J.LT.M(1))GO TO 12
06600 J=M(1)-K
06700 L=J+1
06800 12 WRITE(1,11)L,(M(NM),NM=K,K+J)
06900 RETURN
07000 11 FORMAT(' 9999',I3,8I10)
07100 END
07200
07300 SUBROUTINE REPACK(K,M,N,I)
07400 COMMON/LL/L
07500 DIMENSION I(1)
07600 M=M*10000
07700 IF(M)M=10000000-M
07800 IF(N)N=1000-N
07900 M=M+L
08000 I(K)=M+N
08100 RETURN
08200 END